perm filename FUNCS.FAI[MUS,LCS] blob
sn#365820 filedate 1978-01-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE FUNCS
C00012 ENDMK
C⊗;
TITLE FUNCS
ENTRY SEE ;FUNCTION SEE(ARRAY)
ENTRY SEG ;FUNCTION SEG(ARRAY FUNC);
ENTRY SYNTH ;FUNCTION SYNTH(ARRAY FUNC);
EXTERNAL RDNUM, DPYSET,ALINE,DPYOUT,DDCLR,TYPLOC
EXTERNAL RVECT,AIVECT,ZERO,SIND
SEG: 0 ;BEGIN
;; HRRZI 15,FSTSAV
;; BLT 15,FSTSAV+14 ;SAVES ACS 0→14
;;;; JSA 16,DDCLR ;VARIABLE X512,K,A1,A2,ST,STPP,STPS,IS,IT,DIF,RK;
SETZ 4, ;A1 A1←0; ST←0; STPP←0; X512←0;
SETZ 2, ;ST
MOVE 10,[999.0]
SETZ 3, ;STPP
SETZ 1, ;X512
SETZM STPP#
SEG1: PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP A2# ;WHILE STPP ≤ 1 DO BEGIN RDNUM(A2);
PUSHJ 17,RETAC
MOVE 5,A2 ; IF A2 =512 THEN X512←A2;
CAME 5,[512.0]
JRST SEG2 ;1 SERVES AS X512
MOVN 1,5 ; X512 IS NOW NEG.
PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP A2 ; IF A2 =512 THEN RDNUM(A2); RDNUM(STPP);
SKIPA
;COMMENT: TYPE 512 AT FIRST TO USE 512 STEPS INSTEAD OF 100 STEPS.;
SEG2: PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP STPP#
PUSHJ 17,RETAC
MOVE 3,STPP
CAMLE 3,[1.0] ; IF STPP ≤ 1 THEN A1←A2;
JRST SEG3
MOVE 4,A2
JRST SEG1 ; END;
SEG3: JUMPL 1,SEG4 ; WHILE STPP < 999 DO BEGIN
MOVE 13,[5.12] ;IS← INT(STPP*5.120+.0001);
FMPR 13,3
FADR 13,[0.0001]
JRST SEG5; IF X512 > 0 THEN IS←INT(STPP+.0001);
SEG4: MOVE 13,[0.0001]
FADR 13,3
SEG5: KIFIX 13,13 ;13 IS "IS"
CAIG 13,=512 ; IF IS > 512 THEN
JRST SEG6 ; (NOT SMOOTHED)
OUTSTR[ASCIZ/ *** SMOOTHED /] ; BEGIN PRINT " *** SMOOTHED ";
MOVEI 6,=511 ; FOR K←0 STEP 1 UNTIL 511 DO
MOVE 7,(16)
;COMMENT: READ 512 NUMS FROM A FUNC FILE.;
SEG7: PUSHJ 17,SAVAC
JSA 16,RDNUM ; BEGIN
JUMP RK# ; RDNUM(RK); FUNC(K)← RK;
PUSHJ 17,RETAC
MOVE RK
MOVEM (7)
AOJ 7, ; END;
SOJGE 6,SEG7
SEGEND: OUTSTR [ASCIZ/SEG ARRAY /] ; SEEIT(FUNC); PRINT "SEG ARRAY ";
;FUNCTION NOTDD -- IF AC0 NEG. IT'S NOT A DATADISC -- FOR 'SEE'
NOTDD: MOVNI 2,1
GETLIN 2 ;0=IT IS A DD
TLNN 2,20000
PUSHJ 17,SHOW ; SETO ;-1=NOT DD
;; HRLZI 15,FSTSAV
;; BLT 15,15 ;RETRIEVES ACS
JRA 16,1(16) ; RETURN; END;
SEG6: SOJ 13, ; STPP ← IS-1; STPS ← STPP-ST;
FLTR 3,13
MOVE 6,3 ;(6=STPS, 3=STP)
FSBR 6,2 ; -ST IS ← INT(STPS); DIF←A2-A1;
KIFIX 13,6 ; 0=IS
MOVE 10,A2
FSBR 10,4 ; IT←INT(ST); ST ← STPP;
KIFIX 11,2 ; 2=IT FOR K←0 STEP 1 UNTIL IS DO
MOVE 2,3 ; BEGIN
SETZ 7, ; RK ← K;
MOVE 12,(16) ; FUNC(K+IT) ← A1+DIF*RK/STPS;
ADD 12,11 ; END;
;; MOVE 14,4
;; FADR 14,10 ; IF STPP = 511 THEN BEGIN
SEG8: FLTR 15,7 ; SEEIT(FUNC);PRINT "SEG ARRAY "; END;
FDVR 15,6 ; IF STPP ≥ 511 THEN RETURN;
FMPR 15,10 ; A1←A2; ST←STPP;
FADR 15,4 ; (+A1)
MOVEM 15,(12) ; RDNUM(A2); RDNUM(STPP);
AOJ 12, ; END;
AOJ 7, ;END;
CAMG 7,13 ;CAMG K,IS
JRST SEG8
CAML 3,[511.0]
JRST SEGEND ;ALL DONE
MOVE 4,A2 ; 4 IS A1
MOVE 6,3 ;6 IS ST, 3 IS STPP
PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP A2
JSA 16,RDNUM
JUMP STPP
PUSHJ 17,RETAC
MOVE 3,STPP
JRST SEG3
SYNTH: 0
;; HRRZI 15,FSTSAV
;; BLT 15,FSTSAV+14
MOVE 1,(16)
MOVEM 1,SY
JSA 16,ZERO ;ZERO OUT THE ARRAY
SY: 0
JSA 16,RDNUM
JUMP STPP ;XX AND H
MOVE 13,STPP
CAMN 13,[99.0]
SETO 13,
MOVEM 13,STPP ; H LATER
MOVE 10,[999.0]
JUMPGE 13,SY2
PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP STPP ;THIS IS H
PUSHJ 17,RETAC
SY2: CAMG 10,STPP
JRST SYNEND
PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP A2 ;A2 IS AMP
PUSHJ 17,RETAC
SETZ 3, ;X
SETZ 4, ;CON
JUMPGE 13,SY3
PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP SY ;SY WILL BE X
JSA 16,RDNUM
JUMP CON#
PUSHJ 17,RETAC
MOVE 3,SY ;X
MOVE 4,CON
FMPR 3,[1.422222]
FADR 3,[1.0]
SY3: MOVEI 6,=511
MOVE 1,(16)
SY4: MOVE 5,3
FMPR 5,[0.703125]
MOVEM 5,RK ;XX
PUSHJ 17,SAVAC
JSA 16,SIND
JUMP RK
PUSHJ 17,RETAC
SYX: FMPR 0,A2 ;AMP
FADR 0,4 ;+CON
CAMGE 4,[100.0]
JRST SY5
;; MOVN 7,[100.0]
;; FADR 7,0
;; FMPRM 7,(1)
FSBR 0,[100.0]
FMPRM 0,(1)
SKIPA
SY5: FADRM 0,(1)
;; MOVE 5,2 ;H
FADR 3,STPP ; X←X+H
CAMLE 3,[512.0]
FSBR 3,[512.0]
AOJ 1,
SOJGE 6,SY4
PUSHJ 17,SAVAC
JSA 16,RDNUM
JUMP STPP ;H
PUSHJ 17,RETAC
JRST SY2
SYNEND: MOVE 1,(16)
MOVE 5,(1)
MOVEI 6,=511
SY6: MOVM 2,(1)
CAMGE 5,2
MOVE 5,2
AOJ 1,
SOJGE 6,SY6
MOVEI 6,=511
MOVE 1,(16)
SY7: MOVE 0,(1)
FDVR 0,5
MOVEM 0,(1)
AOJ 1,
SOJGE 6,SY7
OUTSTR [ASCIZ/ SYNTH ARRAY /]
JRST NOTDD
SAVAC: MOVE 15,[1,,ACSAV]
BLT 15,ACSAV+13 ;SAVES ACS 1→14
POPJ 17,
RETAC: MOVE 15,[ACSAV,,1]
BLT 15,13 ;RETRIEVES THEM
POPJ 17,
DPY: BLOCK =250 ;DISPLAY BUFFER
ACSAV: BLOCK 13
FSTSAV: BLOCK 13
SHOW: JSA 16,DDCLR
JSA 16,DPYSET ↔ JUMP [2]↔ JUMP DPY↔ JUMP [=263]
JSA 16,TYPLOC↔ JUMP [-=100]↔ JUMP [-=412]
JSA 16,ALINE↔ JUMP [-=264]↔ JUMP [=200]
JUMP [=256] ↔ JUMP [=200]
JSA 16,ALINE ↔ JUMP [-=266] ↔ JUMP [=328]
JUMP [-=246] ↔ JUMP [=328]
JSA 16,ALINE ↔ JUMP [-=266] ↔ JUMP [=456]
JUMP [-=246] ↔ JUMP [=456]
JSA 16,ALINE ↔ JUMP [-=266] ↔ JUMP [=72]
JUMP [-=246] ↔ JUMP [=72]
JSA 16,ALINE ↔ JUMP [-=266] ↔ JUMP [-=56]
JUMP [-=246] ↔ JUMP [-=56]
JSA 16,ALINE ↔ JUMP [-=256] ↔ JUMP [-=56]
JUMP [-=256] ↔ JUMP [=456]
JSA 16,ALINE ↔ JUMP [0] ↔ JUMP [=190]
JUMP [0] ↔ JUMP [=210]
JSA 16,ALINE ↔ JUMP [-=128] ↔ JUMP [=190]
JUMP [-=128] ↔ JUMP [=210]
JSA 16,ALINE ↔ JUMP [=128] ↔ JUMP [=190]
JUMP [=128] ↔ JUMP [=210]
MOVE 1,(16) ;FUNC(0)
MOVE 1,(1)
FMPR 1,[256.0]
FADR 1,[200.0]
KIFIX 1,1
MOVEM 1,RK ;OLD IY
JSA 16,AIVECT ↔ JUMP [-=256] ↔ JUMP RK
MOVEI 2,1
SH1: MOVEM 2,STPP
MOVE 3,(16)
ADD 3,STPP
MOVE 1,(3)
FMPR 1,[256.0]
FADR 1,[200.0]
KIFIX 1,1 ;OLD IY2
MOVE 2,1
SUB 1,RK
MOVEM 1,ACSAV
MOVEM 2,RK ;IY←IY2
JSA 16,RVECT ↔ JUMP [2] ↔ JUMP ACSAV
MOVE 2,STPP
ADDI 2,2 ;SEE EVERY 2ND POINT
CAIG 2,=511
JRST SH1
JSA 16,DPYOUT ↔ JUMP [2]
POPJ 17,
SEE: 0
;; JSA 16,DDCLR ;CLEAR THE DATADISK SCREEN
PUSHJ 17,SHOW
JRA 16,1(16) ; RETURN; END;
END